Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/ddj0290.arc/LIAO.LST

File List | 1990-01-07 | 14KB | 396 lines

_SELF-ADJUSTING DATA STRUCTURES_
by Andrew M. Liao


[LISTING ONE]

{*** Singly linked move-to-the front list ***}
{*** Contents: "LInsert", "Mtffind" ***}

{ Data Structure:
  ptr=^node;
  node=RECORD rec:item; next:ptr; END;  }

PROCEDURE LInsert(arg:item; VAR root:ptr);
    VAR p:ptr;                          { To generate storage }
    BEGIN
      NEW(p);                           { Allocate }
      p^.rec:=arg;                      { Add data }
      p^.next:=root;                    { Place at front of list }
      root:=p;                          { Point to new front of list }
    END;

FUNCTION Mtffind(arg:item; VAR root:ptr;):boolean;
    VAR temp1,temp2:ptr;                   { Search pointers }
        found:boolean;                     { TRUE iff found }
    BEGIN
      temp1:=root;                         { Get a copy of starting location }
      temp2:=root;                         { Secondary copy }
      found:=false;                        { Nothing found yet }

      WHILE (temp1<>NIL) AND (NOT found) DO
          BEGIN
            IF temp1^.rec<>arg THEN        { Found it? }
                BEGIN                      { Nope... }
                  temp2:=temp1;            { Move trailing pointer }
                  temp1:=temp1^.next;      { Move search pointer }
                END
            ELSE found:=true;              { Yup... }
          END;

      IF found THEN                        { Move item to front of list }
          BEGIN
            temp2^.next:=temp1^.next;
            IF temp1<>root THEN temp1^.next:=root;
            root:=temp1;
          END;

      Mtffind:=found;
    END;


[LISTING TWO]

{*** Move To The Front Splay Tree ***}
{*** Contents: SplaySearch, BSInsert, BSDelete ***}

{ Data Structure:
  ptr=^node;
  node=RECORD data:key; left,right:ptr; END;    }

FUNCTION SplaySearch(x:key; VAR p:ptr):boolean;
TYPE noderec=RECORD                     { Temporary Tree Pointer Def. }
               left,right:ptr;
             END;
VAR l,r:noderec;                        { Temporary Trees }
    done:boolean;                       { TRUE if NIL encountered in search }

  PROCEDURE RRot(VAR p:ptr);
    VAR temp,temp1:ptr;                 { Temporary pointers }
    BEGIN
      IF p<>NIL THEN                    { Don't rotate if nothing's there }
        IF p^.left<>NIL THEN            { No left edge - don't rotate }
          BEGIN
            temp:=p; temp1:=p^.left^.right;  { Copy root & 2ndary child }
            p:=temp^.left; p^.right:=temp;   { Rotate root }
            temp^.left:=temp1;         { Reattach 2ndary child }
          END;
    END;

  PROCEDURE LRot(VAR p:ptr);
    VAR temp,temp1:ptr;                 { Temporary pointers }
    BEGIN
      IF p<>NIL THEN                    { Don't rotate if nothing's there }
        IF p^.right<>NIL THEN           { No right edge - don't rotate }
          BEGIN
            temp:=p; temp1:=p^.right^.left;  { Copy root & 2ndary child }
            p:=temp^.right; p^.left:=temp;   { Rotate root }
            temp^.right:=temp1;        { Reattach 2ndary child }
          END;
    END;

  PROCEDURE LnkRight(VAR p:ptr; VAR r:noderec);
    VAR temp:ptr;                       { Temporary pointer }
    BEGIN
      IF p^.left<>NIL THEN              { No left child - don't cut & link }
        BEGIN
          temp:=p^.left; p^.left:=NIL;  { Remember left child & break link }
          IF r.left=NIL THEN            { Attach to temporary tree }
            BEGIN r.left:=p; r.right:=p;END { Empty tree? }
          ELSE                          { Just add to bottom leftmost }
            BEGIN r.right^.left:=p; r.right:=r.right^.left; END;
          p:=temp;                      { New root is left child }
        END;
    END;

  PROCEDURE LnkLeft(VAR p:ptr; VAR l:noderec);
    VAR temp:ptr;                       { Temporary pointer }
    BEGIN
      IF p^.right<>NIL THEN             { No right child - don't cut & link }
        BEGIN
          temp:=p^.right; p^.right:=NIL;{ Remember right child & break link }
          IF l.left=NIL THEN            { Attach to temporary tree }
            BEGIN l.left:=p; l.right:=p;END { Empty tree? }
          ELSE                          { Just add to bottom rightmost }
            BEGIN l.right^.right:=p; l.right:=l.right^.right; END;
          p:=temp;                      { New root is right child }
        END;
    END;

  PROCEDURE Assemble(VAR p:ptr; VAR l,r:noderec);
    VAR temp,temp1:ptr;
    BEGIN
      temp:=p^.left; temp1:=p^.right;   { Hold onto subtrees }
      IF l.left<>NIL THEN
        BEGIN
          p^.left:=l.left;              { Attach temporary left subtree }
          l.right^.right:=temp;         { Reattach orginal left subtree }
        END;
      IF r.left<>NIL THEN
        BEGIN
          p^.right:=r.left;             { Attach temporary right subtree }
          r.right^.left:=temp1;         { Reattach original right subtree }
        END;
    END;

  BEGIN
    l.left:=NIL; l.right:=NIL;          { Initialize temp trees }
    r.left:=NIL; r.right:=NIL;
    done:=false;                        { Init to "item maybe there" }
    IF p<>NIL THEN                      { No search if tree's empty }
      BEGIN
      REPEAT
        IF (x<p^.data) THEN             { Item on left subtree? }
          IF (p^.left<>NIL) THEN
            BEGIN
              IF x=p^.left^.data THEN LNKRIGHT(p,r)
              ELSE
              IF x<p^.left^.data THEN BEGIN RRot(p); LNKRIGHT(p,r); END
              ELSE
              IF x>p^.left^.data THEN BEGIN LNKRIGHT(p,r);LNKLEFT(p,l);END;
            END ELSE done:=TRUE
        ELSE
        IF (x>p^.data) THEN             { Item on right subtree? }
          IF (p^.right<>NIL) THEN
            BEGIN
              IF x=p^.right^.data THEN LNKLEFT(p,l)
              ELSE
              IF x>p^.right^.data THEN BEGIN LRot(p); LNKLEFT(p,l); END
              ELSE
              IF x<p^.right^.data THEN BEGIN LNKLEFT(p,l);LNKRIGHT(p,r);END;
            END ELSE done:=TRUE;
      UNTIL (x=p^.data) OR DONE;
      ASSEMBLE(p,l,r); SplaySearch:=(x=p^.data);
    END ELSE SplaySearch:=FALSE;
  END;

PROCEDURE BSInsert(x:key; VAR root:ptr);
VAR p:ptr;
BEGIN
  NEW(p);
  p^.data:=x;
  p^.left:=NIL; p^.right:=NIL;
  IF root=NIL THEN root:=p                      { No tree, just insert }
  ELSE
  BEGIN
    IF NOT SplaySearch(x,root) THEN             { Is it already there? }
      IF x<root^.data THEN                      { Less than? }
        BEGIN
          p^.right:=root;                       { Root item greater than }
          p^.left:=root^.left;                  { Link up left child }
          root^.left:=NIL; root:=p;             { Break link; root=new item }
        END
      ELSE
      IF x>root^.data THEN                      { Greater than? }
        BEGIN
          p^.left:=root;                        { Root item less than }
          p^.right:=root^.right;                { Link up right child }
          root^.right:=NIL; root:=p;            { Break link; root=new item }
        END;
  END;
END;

PROCEDURE BSDelete(x:key; VAR root:ptr);
VAR temp1,temp2,temp4:ptr;
    temp3:key;
    flg:boolean;
BEGIN
  IF SplaySearch(x,root) THEN
    BEGIN
      temp1:=root^.left; temp2:=root^.right;    { Save subtrees }
      IF temp1<>NIL THEN                        { Is there a left subtree? }
        BEGIN
          temp4:=temp1;
          WHILE temp4^.right<>NIL DO            { MTF max left tree element }
            temp4:=temp4^.right;
          temp3:=temp4^.right^.data;
          flg:=SplaySearch(temp3,temp1);
          temp1^.right:=temp2;                  { Attach right subtree }
        END ELSE temp1:=temp2;                  { Just attach right tree }
       dispose(root);
       root:=temp1;                             { Return new tree }
    END;
END;


[LISTING THREE]

{*** Self-adjusting heap ***}
{*** Contents: Merge, Min, Insert, DeleteMin routines ***}

{ Data Structure:
  ptr=^node;
  node=RECORD data:item; left,right:ptr; END;   }

FUNCTION Merge(q1,q2:ptr):ptr;
  TYPE Qrec=RECORD
                front,rear:ptr;
            END;
  VAR Q:Qrec;
  PROCEDURE Enqueue(VAR q1:ptr; VAR Q:Qrec);
    VAR temp:ptr;
    BEGIN
      temp:=q1;                         { Save top of heap }
      q1:=q1^.right;                    { Point to next top of heap }
      temp^.right:=temp^.left;          { Swap right child to left }
      temp^.left:=NIL;                  { Make sure left link's broken }
      IF q.front=NIL THEN               { Empty merge queue }
        BEGIN
          q.front:=temp; q.rear:=temp;
        END
      ELSE                              { Oops, just add to last leftchild }
        BEGIN
          q.rear^.left:=temp; q.rear:=temp;
        END;
    END;
  BEGIN
    q.front:=NIL; q.rear:=NIL;          { Init merge queue }
    WHILE (q1<>NIL) AND (q2<>NIL) DO    { Pairwise compare and merge }
        IF q1^.data<=q2^.data THEN Enqueue(q1,q)
        ELSE Enqueue(q2,q);

    IF (q1<>NIL) AND (q2=NIL) THEN
      BEGIN
        IF q.rear<>NIL THEN q.rear^.left:=q1
        ELSE q.front:=q1;
      END
    IF (q1=NIL) AND (q2<>NIL) THEN
      BEGIN
        IF q.rear<>NIL THEN q.rear^.left:=q2
        ELSE q.front:=q2;
      END;
    Merge:=q.front;
  END;

FUNCTION Min(q1:ptr; VAR x:ptr):boolean;
  BEGIN
    x:=q1;
    Min:=(q1<>NIL);
  END;

PROCEDURE Insert(x:item; VAR q:ptr);
  VAR p:ptr;
  BEGIN
    NEW(p);                             { Allocate }
    p^.data:=x;                         { Fill it! }
    p^.left:=NIL; p^.right:=NIL;        { No children }
    q:=Merge(q,p);                      { Add it to heap }
  END;

FUNCTION DeleteMin(q:ptr; VAR x:ptr):ptr;
  BEGIN
    IF Min(q,x) THEN                    { Is there a min to delete? }
      DeleteMin:=Merge(q^.left,q^.right)
    ELSE DeleteMin:=NIL;                { Nothing at all }
  END;

{ Pairing Heaps as described by Tarjan, et al from Algorithmica:
  Data Structure:
  TYPE hptr=^node;
       node=RECORD
              wt:integer;
              parent,left,right:hptr;
            END;                        }

FUNCTION Merge(arg1,arg2:hptr):hptr;
BEGIN
  IF (arg1<>NIL) AND (arg2<>NIL) THEN           { 2 Queues to merge? }
    BEGIN
      IF arg1^.wt<arg2^.wt THEN         { Which is minimal? }
        BEGIN
          arg2^.parent:=arg1;                   { Who's the parent? }
          arg2^.right:=arg1^.left;              { Point to arg1's child }
          arg1^.left:=arg2;                     { It's officially a child }
          Merge:=arg1;
        END
      ELSE
        BEGIN
          arg1^.parent:=arg2;                   { Who's the parent? }
          arg1^.right:=arg2^.left;              { Point to arg2's child }
          arg2^.left:=arg1;                     { It's officially a child }
          Merge:=arg2;
        END;
     END
   ELSE
   IF (arg1<>NIL) THEN Merge:=arg1              { Just arg1's queue }
   ELSE Merge:=arg2                             { Anything else }
END;

PROCEDURE Insert(a1,a2,x:integer; VAR root:hptr);
VAR p:hptr;
BEGIN
  New(p);                                       { Allocate }
  p^.v1:=a1; p^.v2:=a2;
  p^.wt:=x;  p^.parent:=NIL;                    { Set key }
  p^.left:=NIL; p^.right:=NIL;                  { Set pointers }
  root:=Merge(p,root);                          { Add it... }
END;

FUNCTION Min(root:hptr; VAR minitem:hptr):boolean;
BEGIN
  minitem:=root;                                { What's at the root? }
  Min:=(minitem<>NIL);                          { Anything there? }
END;

FUNCTION DeleteMin(root:hptr; VAR minitem:hptr):hptr;
VAR arg1,arg2,p1:hptr;
BEGIN
  IF Min(root,minitem) THEN
    BEGIN
      root:=NIL;                                { ReInit root }
      p1:=minitem^.left;                        { Save kids }
      WHILE p1<>NIL DO                          { For all subtrees }
        BEGIN
          arg1:=p1;                             { First Subtree }
          p1:=p1^.right;                        { Move along }
          arg2:=p1;                             { Next potential subtree }
          IF p1<>NIL THEN p1:=p1^.right;        { If not NIL, move on }
          root:=Merge(Merge(arg1,arg2),root);   { Merge result with current }
        END;
       IF root<>NIL THEN root^.right:=NIL;
       DeleteMin:=root;
    END ELSE DeleteMin:=NIL;
END;

FUNCTION LinkSearch(p:hptr):hptr;
VAR temp:hptr;
BEGIN
  temp:=p^.parent^.left;
  WHILE (temp<>p) AND (temp^.right<>p) AND (temp^.right<>NIL) DO
    temp:=temp^.right;
  LinkSearch:=temp;
END;

FUNCTION DecreaseKey(change:integer; p,root:hptr):hptr;
VAR temp:hptr;
BEGIN
  IF (p<>NIL) AND (root<>NIL) THEN
    BEGIN
      p^.wt:=p^.wt-ABS(change);
      IF p=root THEN DecreaseKey:=root
      ELSE
      BEGIN
        temp:=LinkSearch(p);
        IF temp=p THEN p^.parent^.left:=p^.parent^.left^.right
        ELSE temp^.right:=p^.right;
        DecreaseKey:=Merge(p,root);
      END;
    END;
END;

FUNCTION Delete(p,root:hptr):hptr;
VAR temp:hptr;
BEGIN
  IF (p<>NIL) AND (root<>NIL) THEN
    BEGIN
      IF p=root THEN Delete:=DeleteMin(root,temp)
      ELSE
      BEGIN
        temp:=LinkSearch(p);
        IF temp=p THEN p^.parent^.left:=p^.parent^.left^.right
        ELSE temp^.right:=p^.right;
        Delete:=Merge(DeleteMin(p,temp),root);
      END;
    END ELSE Delete:=root;
END;